home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / MyResources.p < prev    next >
Text File  |  1997-06-06  |  3KB  |  120 lines
  1. unit MyResources;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Types, Quickdraw;
  7.     
  8.     const
  9.         kResChain = -13001;
  10.         kCurrentResFile = -13002;
  11.         
  12.     function MGetResource( resfile: integer; typ: OSType; id: integer; var data: univ Handle ): OSErr;
  13.     function MGetDetachedResource( resfile: integer; typ: OSType; id: integer; var data: univ Handle ): OSErr;
  14.     function MGetPicture( id: integer; var ph: PicHandle ): OSErr;
  15.     function MReplaceResource( resfile: integer; typ: OSType; id: integer; const name: Str255; data: univ Handle ): OSErr;
  16.  
  17. implementation
  18.  
  19.     uses
  20.         Errors, Memory, Resources,
  21.         MyAssertions, MyUtils;
  22.  
  23. { Damn Resource Manager is so broken! }
  24.     function MGetResError( data: Handle ): OSErr;
  25.         var
  26.             err: OSErr;
  27.     begin
  28.         if data <> nil then begin
  29.             err := noErr;
  30.         end else begin
  31.             err := ResError;
  32.             if err = noErr then begin
  33.                 err := -1;
  34.             end;
  35.         end;
  36.         MGetResError := err;
  37.     end;
  38.     
  39.     function MGetPicture( id: integer; var ph: PicHandle ): OSErr;
  40.         var
  41.             err: OSErr;
  42.     begin
  43.         err := noErr;
  44.         ph := GetPicture( id );
  45.         if (ph = nil) | (ph^ = nil) then begin
  46.             err := MemError;
  47.             if err = noErr then begin
  48.                 err := resNotFound;
  49.             end;
  50.             ph := nil;
  51.         end;
  52.         MGetPicture := err;
  53.     end;
  54.     
  55.     function MGetResource( resfile: integer; typ: OSType; id: integer; var data: univ Handle ): OSErr;
  56.         var
  57.             err: OSErr;
  58.             saved: integer;
  59.     begin
  60.         case resfile of
  61.             kResChain: begin
  62.                 data := GetResource( typ, id );
  63.                 err := MGetResError( data );
  64.             end;
  65.             kCurrentResFile: begin
  66.                 data := Get1Resource( typ, id );
  67.                 err := MGetResError( data );
  68.             end;
  69.             otherwise begin
  70.                 saved := CurResFile;
  71.                 UseResFile( resfile );
  72.                 data := Get1Resource( typ, id );
  73.                 err := MGetResError( data );
  74.                 UseResFile( saved );
  75.             end;
  76.         end;
  77.         MGetResource := err;
  78.     end;
  79.     
  80.     function MGetDetachedResource( resfile: integer; typ: OSType; id: integer; var data: univ Handle ): OSErr;
  81.         var
  82.             err: OSErr;
  83.     begin
  84.         err := MGetResource( resfile, typ, id, data );
  85.         if err = noErr then begin
  86.             HNoPurge( data );
  87.             DetachResource( data );
  88.         end;
  89.         MGetDetachedResource := err;
  90.     end;
  91.     
  92.     function MReplaceResource( resfile: integer; typ: OSType; id: integer; const name: Str255; data: univ Handle ): OSErr;
  93.         var
  94.             err: OSErr;
  95.             saved: integer;
  96.             old: Handle;
  97.     begin
  98.         Assert( resfile <> kResChain );
  99.         saved := CurResFile;
  100.         if resfile <> kCurrentResFile then begin
  101.             UseResFile( resfile );
  102.         end;
  103.         old := Get1Resource( typ, id );
  104.         if old <> nil then begin
  105.             RemoveResource( old );
  106.             DisposeHandle( old );
  107.         end;
  108.         AddResource( data, typ, id, name );
  109.         err := ResError;
  110.         ChangedResource( data );
  111.         AddOSErr( err, ResError );
  112.         WriteResource( data );
  113.         AddOSErr( err, ResError );
  114.         DetachResource( data );
  115.         UseResFile( saved );
  116.         MReplaceResource := err;
  117.     end;
  118.     
  119. end.
  120.